home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / Extras / Clone / startjforth.asm < prev    next >
Encoding:
Assembly Source File  |  1992-05-31  |  18.0 KB  |  642 lines
  1.  
  2. \ Mike Haas
  3. \
  4. \    'StartJForth' is the very first to execute in any target-compiled
  5. \ image.  It initializes the virtual-machine CPU registers so that
  6. \ high-level code can get up and running quickly.
  7. \
  8. \    While definitions are previous to 'StartJForth' in this file,
  9. \ the Target Compiler assembles 'StartJForth' first, and later
  10. \ resolves the references to these words.
  11. \
  12. \
  13. \ Register assignments and names used in JForth 1.2 Assembler...
  14. \
  15. \     a0 = 0ar = temp0     d0 = 0dr = \
  16. \     a1 = 1ar = temp1     d1 = 1dr = |
  17. \     a2 = 2ar = loc       d2 = 2dr = |-- available data regs, unnamed
  18. \     a3 = 3ar = +64k      d3 = 3dr = |
  19. \     a4 = 4ar = org       d4 = 4dr = /
  20. \     a5 = 5ar = up        d5 = 5dr = iloop
  21. \     a6 = 6ar = dsp       d6 = 6dr = jloop
  22. \     a7 = 7ar = rp        d7 = 7dr = tos
  23. \
  24. \ MODS:
  25. \ 00000  03-dec-88  mdh  Add allocation of the DOS0 buffer (oops!)
  26. \ 00001  04-mar-89  mdh  use shorter, more efficient opcode
  27. \ 00002  15-aug-89  mdh  implicit >newline in ExitJForth
  28. \ 00003  27-nov-91  plb  fix ASM syntax error, thanks Jerry Kallaus
  29. \ 00004  12-jan-92  mdh  Incorporate CLILOCK
  30. \ 00005  13-jan-92  mdh  changed wb_lib to workbench_lib
  31.  
  32. only forth definitions
  33.  
  34. anew Task-StartJForth.asm
  35.  
  36. variable StackSize        4096 StackSize      !
  37. variable DictionarySize    256 DictionarySize !
  38. variable Enable_Cancel    \ set true to allow ^C,^D,^E or ^F cancels
  39.  
  40. .NEED UserCleanUP
  41. defer UserCleanUP   ' noop is UserCleanUp
  42. .THEN
  43.  
  44. also TGT definitions
  45.  
  46.  
  47. decimal
  48.  
  49. max-inline @     6 max-inline !
  50. verify-libs @    verify-libs off
  51.  
  52. variable _main            \ will hold target address of 'main'
  53. variable StackBlock       \ saves the addr gotten for Data stack
  54. variable DOSBlock         \ block allocated for dos0 buffer
  55. variable CMDBlock         \ block allocated for DOSCOMMAND/TIB
  56.  
  57. \ variable DPBlock          \ block allocated for dictionary
  58.  
  59.  
  60. : ExitFreeBlocks  ( -- )  fcloseatbye  @&closefiles  ;
  61. : ExitCloseFiles  ( -- )  freeatbye    @&freeblocks  ;
  62. : ExitCloseLibs   ( -- )  CloseAllLibs ;
  63.  
  64.  
  65. : ExitFree?  ( var -- )
  66.   @  -dup
  67.   IF
  68.      XFreeBLK
  69.   THEN
  70. ;
  71.  
  72.  
  73. : ReturnStuff  ( -- )
  74.   what's UserCleanUp
  75.   ' noop dup is UserCleanUp  is ErrorCleanUp
  76.   execute
  77.   ExitFreeBlocks
  78.   ExitCloseFiles
  79.   ExitCloseLibs
  80.   StackBlock ExitFree?
  81.   CMDBlock   ExitFree?
  82. \ DPBlock    ExitFree? 
  83.   DOSBlock   ExitFree?
  84.   WBMESSAGE @  dup>r
  85.   IF            \ 00004
  86.      WBLOCK
  87.   ELSE
  88.      CLILOCK
  89.   THEN
  90.   dup>r @ call dos_lib CurrentDir  dup r> @ -
  91.   IF
  92.      call dos_lib UnLock
  93.   THEN
  94.   drop
  95.   dos_lib -lib
  96.   r@
  97.   IF
  98.         call Exec_lib Forbid   drop
  99.      r@ call Exec_lib ReplyMsg drop
  100.   THEN
  101.   rdrop
  102. ;
  103.  
  104.  
  105. asm ExitJForth   ( get oudda here! )
  106.     CallCFA OUT               start 00002
  107.     tst.l   0(org,tos.l)
  108.     beq     1$
  109.     moveq.l #[eol],tos
  110.     CallCFA emit
  111. 1$: CallCFA FlushEmit         end 00002
  112.     move.l  rp,dsp            move the data stack away from allocated mem
  113.     sub.l   #2048,dsp         ...like 2k below the return stk
  114.     CallCFA ReturnStuff       give it all back
  115.     CallCFA RetCode           get any returncode
  116.     move.l  0(org,tos.l),d0   ...in d0
  117.     CallCFA R0                get the original returnstack...
  118.     move.l  0(org,tos.l),d4
  119.     add.l   org,d4
  120.     move.l  d4,rp
  121. end-code
  122.  
  123.  
  124. : SetSignal()  ( states mask -- prevstates )
  125.   call Exec_lib SetSignal
  126. ;
  127.  
  128.  
  129. only forth definitions   also tgt
  130.  
  131.  
  132. ASM (CancelKey?) ( -- 0=no, otherwise, ascii C, D, E, or F )
  133.     move.l    tos,-(dsp)            set stack to returning level
  134.     move.l    dsp,-(rp)             and save it
  135.     sub.l     #4,dsp
  136.     clr.l     (dsp)                 read the signal bits
  137.     moveq.l   #0,tos
  138.     CallCFA   SetSignal()
  139.     move.l    #12,d4
  140.     lsr.w     d4,tos                move bits 15-12 to lo nibble
  141.     move.b    tos,d4
  142.     and.b     #$0f,d4               clr higher nibble
  143.     beq       8$
  144.     move.l    #[ascii F],tos        put an 'F' in tos
  145.     cmp.b     #8,d4                 is the ^F bit set?
  146.     bge       1$
  147.     subq.l    #1,tos                char -> E
  148.     cmp.b     #4,d4                 is the ^E bit set?
  149.     bge       1$
  150.     subq.l    #1,tos                char -> D
  151.     cmp.b     #2,d4                 is the ^D bit set?
  152.     bge       1$
  153.     subq.l    #1,tos                char -> C
  154.     cmp.b     #1,d4                 is the ^C bit set?
  155.     bge       1$
  156. 8$: moveq.l   #0,tos                none set, return false
  157. 1$: tst.b     tos                   anything there?
  158.     beq       3$
  159.     move.l    tos,-(dsp)            yes, clear the signal bits
  160.     clr.l     -(dsp)
  161.     move.l    #$f000,tos
  162.     CallCFA   SetSignal()
  163.     move.l    (dsp)+,tos
  164. 3$: move.l    (rp)+,dsp
  165. end-code
  166.  
  167. ' (CancelKey?) is CancelKey?
  168.  
  169. : (CancelNow?)  ( -- )
  170.   Enable_Cancel @
  171.   IF
  172.      CancelKey? -dup
  173.      IF
  174.         >newline  ascii ^ emit  emit ."  Abort"
  175.         cr  quit
  176.      THEN
  177.   THEN
  178. ;
  179.  
  180. ' (CancelNow?) is CancelNow?
  181.  
  182. only forth   also tgt definitions
  183.  
  184.  
  185. ASM InitLibraries  ( -- , init the Exec & dos libs )
  186.     move.l    tos,-(rp)            just save the data stack, we'll restore it
  187.     move.l    dsp,-(rp)
  188.     CallCFA   Exec_Lib             get the pointer to the exec_lib
  189.     move.l    $4.w,0(org,tos.l)    ( 00001 )
  190.     CallCFA   RetCode              give a message if we fail to allocate
  191.     move.l    tos,-(rp)
  192.     move.l    #1001,0(org,tos.l)
  193.     CallCFA   DOS_Name             get ready to open DOS...
  194.     add.l     org,tos              >abs
  195.     move.l    tos,-(dsp)
  196.     moveq.l   #0,tos
  197.     FORTH{    ] call Exec_Lib OpenLibrary  [  }
  198.     tst.l     tos                  did we succeed?
  199.     bne.s     1$
  200.     CallCFA   ExitJForth
  201. 1$: CallCFA   DOS_lib              guess so, install the pointer
  202.     move.l    (dsp),0(org,tos.l)
  203.     move.l    (rp)+,tos            adjust the return code
  204.     sub.l     #1,0(org,tos.l)
  205.     move.l    (rp)+,dsp            restore the stack
  206.     move.l    (rp)+,tos
  207. end-code
  208.  
  209.  
  210. ASM InitStacks
  211.     move.l    tos,-(rp)            save CLI arguments  ( - a1 a2 )
  212.     move.l    (dsp),-(rp)
  213.     CallCFA   RetCode              register some success( - a1 a2 rc )
  214.     sub.l     #1,0(org,tos.l)
  215.     CallCFA   StackSize            get the desired stksize ( - a1 a2 rc ss )
  216.     move.l    0(org,tos.l),tos     00003 , removed .L from ",tos.L"
  217.     move.l    tos,-(rp)            save it on the return stack
  218.     move.l    #[MEMF_CLEAR],(dsp)  finish setup for allocblock ( a a mc s )
  219.     CallCFA   XAllocBLK            ( a a adr )
  220.     tst.l     tos                  did we succeed?
  221.     bne.s     1$
  222.     CallCFA   ExitJForth
  223. 1$: CallCFA   StackBlock           ( a a adr vadr )
  224.     move.l    (dsp),0(org,tos.l)
  225.     move.l    (dsp)+,tos           ( a a adr )
  226.     add.l     (rp)+,tos            point to the END of the area
  227.     sub.l     #32,tos              give a little 'overflow' room
  228.     move.l    tos,dsp              install it
  229.     add.l     org,dsp
  230.     CallCFA   S0
  231.     move.l    (dsp)+,0(org,tos.l)  put it in S0
  232.     sub.l     #8,dsp
  233.     move.l    (rp)+,(dsp)          recover the CLI arguments
  234.     move.l    (rp)+,tos
  235.     move.l    rp,d0                set R0 to original stack value
  236.     addq.l    #8,d0                ...we're 2 levels down
  237.     sub.l     org,d0
  238.     CallCFA   R0
  239.     move.l    d0,0(org,tos.l)
  240.     move.l    (dsp)+,tos
  241. end-code
  242.  
  243. ASM AArea   ( allocate an area of size in d0, return adr in d0 )
  244.             ( d0 = 0 if not successful )
  245.     move.l    tos,-(dsp)
  246.     move.l    #[MEMF_CLEAR],tos
  247.     move.l    tos,-(dsp)
  248.     move.l    d0,tos
  249.     CallCFA   XAllocBLK
  250.     tst.l     tos
  251.     bne       1$
  252.     CallCFA   ExitJForth
  253. 1$: move.l    tos,d0
  254.     move.l    (dsp)+,tos
  255. end-code
  256.  
  257. ASM InitBlocks  ( -- )  build a dictionary area and a TIB
  258.     move.l    tos,-(dsp)       save stack condition
  259.     move.l    dsp,-(rp)
  260.     \
  261.     \ allocate the TIB
  262.     \
  263.     move.l    #1028,d0
  264.     CallCFA   AArea
  265.     CallCFA   CMDBlock
  266.     move.l    d0,0(org,tos.l)
  267.     addq.l    #1,d0            count will be at beginning
  268.     CallCFA   'TIB
  269.     move.l    d0,0(org,tos.l)
  270.     \
  271.     \ allocate a DOS0 Buffer
  272.     \
  273.     move.l    #258,d0
  274.     CallCFA   AArea
  275.     CallCFA   DOSBlock
  276.     move.l    d0,0(org,tos.l)
  277.     \
  278.     \ leave
  279.     \
  280.     move.l    (rp)+,dsp        restore stack condition
  281.     move.l    (dsp)+,tos
  282. end-code
  283.  
  284.  
  285. \ getmodule includes
  286.  
  287.  
  288. ASM AddCMD   ( -- , d0=#chars  a0=from  a1=countaddr )
  289.     clr.l     d1
  290.     move.b    (a1),d1       get curr str len
  291.     move.l    d1,d2         copy it
  292.     add.b     d0,d1         increment it
  293.     move.b    d1,(a1)+      put it there, point to text
  294.     add.l     d2,a1         point to end of string
  295. 1$: move.b    (a0)+,(a1)+
  296.     subq.l    #1,d0
  297.     bne.s     1$
  298. end-code
  299.  
  300.  
  301. ASM InitCLI   ( CLIargs $cnt absCLI -- )
  302.     move.l    dsp,d0
  303.     addq.l    #8,d0
  304.     move.l    d0,-(rp)                   save final stack adr-4
  305.     lsl.l     #2,tos                     BCPL convert
  306.     sub.l     org,tos                    >rel
  307.     FORTH{ ]  ..@ cli_CommandName [ }
  308.     lsl.l     #2,tos                     BCPL convert
  309.     move.l    tos,a0                     a0=abs$1c
  310.     move.l    (dsp)+,d4                  d4=cnt$2
  311.     move.l    (dsp)+,d3                  d3=rel$2
  312.     add.l     org,d3                     d3=abs$2
  313.     CallCFA   CLICommand
  314.     add.l     org,tos                    d7=absCMD
  315.     move.l    tos,up                     up=absCMD
  316.     clr.l     d0  
  317.     move.b    (a0)+,d0                   d0=cnt$1
  318.     CallCFA   >IN
  319.     move.l    d0,0(org,tos.l)            point >in past the command name
  320.     move.l    up,a1
  321.     CallCFA   ADDCMD
  322.     move.b    #32,(a1)                   add a blank
  323.     add.b     #1,(up)                    inc the cnt
  324.     move.l    d3,a0
  325.     move.l    d4,d0
  326.     move.l    up,a1
  327.     CallCFA   ADDCMD
  328.     CallCFA   WBMESSAGE                  clear these variable under CLI
  329.     clr.l     0(org,tos.l)
  330.     CallCFA   TOOLWINDOW
  331.     clr.l     0(org,tos.l)
  332.     FORTH{ ]  call dos_lib Output [ }
  333.     move.l    tos,d4
  334.     CallCFA   CONSOLEOUT
  335.     move.l    d4,0(org,tos.l)
  336.     FORTH{ ]  call dos_lib Input [ }
  337.     move.l    tos,d4
  338.     CallCFA   CONSOLEIN
  339.     move.l    d4,0(org,tos.l)
  340.     \
  341.     CallCFA   TASKBASE                save away CLILOCK    00004
  342.     move.l    0(org,tos.l),a0          TASKBASE is saved absolute
  343.     move.l    [pr_CurrentDir](a0),d0
  344.     CallCFA   CLILOCK
  345.     move.l    d0,0(org,tos.l)
  346.     \
  347.     move.l    (rp)+,dsp
  348.     move.l    (dsp)+,tos
  349. end-code
  350.  
  351.  
  352. ASM InitWorkBench   ( process -- ) tos holds process
  353.     addq.l    #4,dsp               stack is empty, save it for restore 
  354.     move.l    dsp,-(rp)
  355.     FORTH{ ]  .. pr_MsgPort [ }    get address of message port
  356.     add.l     org,tos              >abs
  357.     move.l    tos,-(rp)            and save it
  358.     FORTH{ ]  call Exec_lib WaitPort  [ }
  359.     move.l    (rp)+,tos
  360.     FORTH{ ]  call Exec_lib GetMsg  [ }   tos has Wbench message
  361.     move.l    tos,-(rp)                   save it
  362.     CallCFA   WBMESSAGE                   put it here
  363.     move.l    (rp),0(org,tos.l)
  364.     move.l    (dsp)+,tos
  365.     sub.l     org,tos                     >rel
  366.     move.l    tos,(rp)                    replace absolute one
  367.     FORTH{ ]  ..@ sm_ArgList if>rel [ }
  368.     tst.l     tos                         is there a pathname?
  369.     beq.s     1$
  370.     FORTH{ ]  ..@ wa_Lock [ }
  371.     CallCFA   WBLOCK
  372.     move.l    (dsp),0(org,tos.l)
  373.     move.l    (dsp),tos
  374.     FORTH{ ]  call DOS_lib CurrentDir drop [ }
  375. 1$: move.l    (rp)+,tos                   get relative startup msg
  376.     FORTH{ ]  ..@ sm_ToolWindow  [ }
  377.     CallCFA   TOOLWINDOW
  378.     move.l    (dsp)+,0(org,tos.l)
  379.     \
  380.     CallCFA   CLILOCK      00004
  381.     CallCFA   off
  382.     \
  383.     move.l    (rp)+,dsp                   empty the stack
  384. end-code
  385.  
  386.  
  387. ASM InitTIB   ( -- )
  388.     move.l    dsp,-(rp)
  389.     CallCFA   CLICOMMAND
  390.     move.l    tos,d4
  391.     CallCFA   #TIB
  392.     clr.l     0(org,tos.l)
  393.     move.b    0(org,d4.l),3(org,tos.l)
  394.     CallCFA   OUT
  395.     clr.l     0(org,tos.l)
  396.     move.l    (rp)+,dsp
  397.     CallCFA   InitAlloc
  398. end-code
  399.  
  400.  
  401. : HLINITJUSTJF  ( ArgsAddr ArgsCnt -- )
  402. \
  403. \ Init the system variables...
  404.   decimal
  405.   ' byefree>    'byefree> !
  406.   ' >byefree    '>byefree !
  407.   ' byeclose>   'byeclose> !
  408.   ' >byeclose   '>byeclose !
  409.   ' noop dup is UserCleanUp   is ErrorCleanup
  410.   freeatbye           off   fcloseatbye     off   >in                 off
  411.   CMDBlock            off   ConsoleIn       off   ConsoleOUT          off
  412.   DOSBlock            off   STackBlock      off
  413.   clist_lib           off   graphics_lib    off   layers_lib          off
  414.   intuition_lib       off   mathffp_lib     off   mathtrans_lib       off
  415.   mathieeedoubbas_lib off   translator_lib  off   icon_lib            off
  416.   diskfont_lib        off   console_lib     off   mathieeesingbas_lib off
  417.   potgo_lib           off   timer_lib       off
  418. \
  419. \ for 2.0...
  420. \
  421.   asl_lib off
  422.   battclock_lib off
  423.   battmem_lib off
  424.   commodities_lib off
  425.   romboot_lib off
  426.   cstrings_lib off
  427.   misc_lib off
  428.   rexxsyslib_lib off
  429.   utility_lib off
  430.   disk_lib off
  431.   gadtools_lib off
  432.   input_lib off
  433.   keymap_lib off
  434.   mathieeesingtrans_lib off
  435.   ramdrive_lib off
  436.   workbench_lib off  \ 00005
  437.   expansion_lib off
  438.   iffparse_lib off
  439. \
  440.   dp drop   $ 7fff,ffff   max-type !
  441.   ' (pushadr) drop   \ make sure it's in the MASTER for overlays
  442.   MODE_OLDFILE  filemode !
  443. \
  444. \ Init the ExecLibrary.......................
  445.   InitLibraries   ( -- Args? cnt? )
  446. \
  447. \ Allocate a bigger stack & set r0...........
  448.   InitStacks        ( -- args? cnt? )
  449. \
  450. \ Allocate a dos0 buffer and a TIB............
  451.   InitBlocks
  452. \
  453. \ Set our task addr in TASKBASE..............
  454.   0 call Exec_lib FindTask dup TaskBase !  >rel  ( -- args cnt task )
  455. \
  456. \ Are we under WorkBench?
  457.   dup >r  ..@ pr_CLI    -dup
  458.   IF
  459.      \
  460.      \ we were run from CLI, convert BCPL, make relative, get args...
  461.        InitCLI
  462.   ELSE
  463.      \
  464.      \ We were started from WorkBench, copy process message...
  465.        2drop  r@ InitWorkBench
  466.   THEN
  467.   rdrop   ( drop taskbase )
  468.   InitTIB
  469. ;
  470.  
  471. : HLINIT  ( ArgsAddr ArgsCnt -- )
  472. \
  473. \ Init the system variables...
  474.   decimal
  475.   ' byefree>    'byefree> !
  476.   ' >byefree    '>byefree !
  477.   ' byeclose>   'byeclose> !
  478.   ' >byeclose   '>byeclose !
  479.   ' noop dup is UserCleanUp   is ErrorCleanup
  480.   freeatbye           off   fcloseatbye     off   >in                 off
  481.   CMDBlock            off   ConsoleIn       off   ConsoleOUT          off
  482.   DOSBlock            off   STackBlock      off
  483.   clist_lib           off   graphics_lib    off   layers_lib          off
  484.   intuition_lib       off   mathffp_lib     off   mathtrans_lib       off
  485.   mathieeedoubbas_lib off   translator_lib  off   icon_lib            off
  486.   diskfont_lib        off   console_lib     off   mathieeesingbas_lib off
  487.   potgo_lib           off   timer_lib       off
  488. \
  489. \ for 2.0...
  490. \
  491.   asl_lib off
  492.   battclock_lib off
  493.   battmem_lib off
  494.   commodities_lib off
  495.   romboot_lib off
  496.   cstrings_lib off
  497.   misc_lib off
  498.   rexxsyslib_lib off
  499.   utility_lib off
  500.   disk_lib off
  501.   gadtools_lib off
  502.   input_lib off
  503.   keymap_lib off
  504.   mathieeesingtrans_lib off
  505.   ramdrive_lib off
  506.   workbench_lib off  \ 00005
  507.   expansion_lib off
  508.   iffparse_lib off
  509. \
  510.   dp drop   $ 7fff,ffff   max-type !
  511.   ' (pushadr) drop   \ make sure it's in the MASTER for overlays
  512.   MODE_OLDFILE  filemode !
  513. \
  514. \ Init the ExecLibrary.......................
  515.   InitLibraries   ( -- Args? cnt? )
  516. \
  517. \ Allocate a bigger stack & set r0...........
  518.   InitStacks        ( -- args? cnt? )
  519. \
  520. \ Allocate a dos0 buffer and a TIB............
  521.   InitBlocks
  522. \
  523. \ Set our task addr in TASKBASE..............
  524.   0 call Exec_lib FindTask dup TaskBase !  >rel  ( -- args cnt task )
  525. \
  526. \ Are we under WorkBench?
  527.   dup >r  ..@ pr_CLI    -dup
  528.   IF
  529.      \
  530.      \ we were run from CLI, convert BCPL, make relative, get args...
  531.        InitCLI
  532.   ELSE
  533.      \
  534.      \ We were started from WorkBench, copy process message...
  535.        2drop  r@ InitWorkBench
  536.   THEN
  537.   rdrop   ( drop taskbase )
  538.   InitTIB
  539. ;
  540.  
  541.  
  542. 0 .IF
  543.  
  544. !!!!  IMPORTANT IMPORTANT IMPORTANT IMPORTANT IMPORTANT IMPORTANT  !!!!
  545.  
  546.       NEVER alter the next word,  StartJForth, unless checking
  547.      with Delta Research.  Doing so may result in unpredictable
  548.      results from CLONEd programs.
  549.      
  550. .THEN
  551.  
  552. ASM StartJForth   ( ENTRY POINT ... rp is set, a0=abs args addr, d0=arg cnt )
  553.     lea      -2(pc),org     Init the origin and +64k regs...
  554.     move.l   org,a3
  555.     add.l    #$10000,a3
  556.     move.l   rp,dsp           Set dsp to (rp - 2048)
  557.     sub.l    #2048,dsp
  558.     sub.l    org,a0           Push relative CLI args onto data stack
  559.     move.l   a0,-(dsp)
  560.     move.l   d0,tos
  561.     CallCFA  HLInit           ( -- &args $cnt ) rest of init is high-level...
  562.     CallCFA  RetCode
  563.     CallCFA  Off
  564.     CallCFA  _main            fetch & call _main ...
  565.     move.l   0(org,tos.l),tos   00003 , was (org.L,tos) , .L in wrong place
  566.     add.l    org,tos
  567.     move.l   tos,a0
  568.     move.l   (dsp)+,tos
  569.     jsr      (a0)
  570.     CallCFA  ExitJForth       on return, cleanup
  571.     move.l   #[version#],d6     \ do NOT remove this line!
  572.     move.l   #[serial# @],tos   \ do NOT remove this line!
  573. End-Code
  574.  
  575.  
  576. 0 .if
  577. The first bytes of an overlayed image are:
  578.   0 = pointer to _main
  579.   4 = start of CallOverlay
  580. .then
  581.  
  582. variable _OverLay
  583.  
  584. ASM StartOverlay  \ ( ??? -- ??? , called by  jsr   2(org,AmemAddr)
  585.     move.l   a5,-(a7)
  586.     lea.l    -4(pc),a5
  587.     move.l   -4(a5),a0
  588.     jsr      0(a5,a0.l)
  589.     move.l   (a7)+,a5
  590. END-CODE
  591.  
  592. 0 .if    this is REAL wrong!
  593. ASM CallOverlay  ( ??? -- ??? )
  594.     bsr.l    _overlay        fetch & call the '_main'
  595.     move.l   -6(pc,tos.l),a0
  596.     move.l   (dsp)+,tos
  597.     jsr      -10(pc,a0.l)
  598. END-CODE
  599. .then
  600.  
  601.  
  602. 0 .IF
  603. ASM StartJustJForth
  604. \
  605. \ loaded into memory and CALLed from some program
  606. \
  607.     movem.l  d1-d7,-(a7)    save the current cpu, except d0
  608. \
  609.     lea      -6(pc),org     Init the origin and +64k regs...
  610.     move.l   org,a3
  611.     add.l    #$10000,a3
  612. \
  613. \ Set dsp temporarily to (rp - 128)  NEED at least in the area of 256
  614.     move.l   rp,dsp
  615.     sub.l    #128,dsp
  616. \
  617. \   sub.l    org,a0           Push relative CLI args onto data stack
  618. \   move.l   a0,-(dsp)
  619. \   move.l   d0,tos
  620. \
  621.     CallCFA  HLInitJustJF     ( -- ) rest of init is high-level...
  622.     CallCFA  RetCode
  623.     CallCFA  Off
  624.     CallCFA  _main            fetch & call _main ...
  625.     move.l   0(org,tos.l),tos   00003 , was (org.L,tos) , .L in wrong place
  626.     add.l    org,tos
  627.     move.l   tos,a0
  628.     move.l   (dsp)+,tos
  629.     jsr      (a0)
  630.     CallCFA  ExitJForth       on return, cleanup
  631.     move.l   #[version#],d6     \ do NOT remove this line!
  632.     move.l   #[serial# @],tos   \ do NOT remove this line!
  633. End-Code
  634. .THEN
  635.  
  636.  
  637. verify-libs !   max-inline !
  638.  
  639.  
  640. only forth definitions
  641. also TGT
  642.